home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Format CD 6
/
Amiga Format AFCD06 (Nov 1996, Issue 90).iso
/
serious
/
commercial
/
cloanto
/
colortype
/
rexx
/
fontpics.ctrx
< prev
next >
Wrap
Text File
|
1996-04-11
|
2KB
|
102 lines
/* ColorType Amiga Rexx script - Copyright © 1996 Cloanto Italia srl */
/* $VER: FontPics.ctrx 1.0 */
/**
This script scans the user-specified path and, for each font in that
path, creates an IFF-ILBM image showing all characters in the font.
The resulting images are identical to those generated by ColorType's
"Show Font" function.
*/
IF ARG(1, EXISTS) THEN
PARSE ARG CTPORT
ELSE
CTPORT = 'COLORTYPE'
IF ~SHOW('P', CTPORT) THEN DO
IF EXISTS('ColorType:ColorType') THEN DO
ADDRESS COMMAND 'Run >NIL: ColorType:ColorType'
DO 30 WHILE ~SHOW('P',CTPORT)
ADDRESS COMMAND 'Wait >NIL: 1 SEC'
END
END
ELSE DO
SAY "ColorType could not be loaded."
EXIT 10
END
END
IF ~SHOW('P', CTPORT) THEN DO
SAY 'ColorType Rexx port could not be opened.'
EXIT 10
END
ADDRESS VALUE CTPORT
OPTIONS RESULTS
OPTIONS FAILAT 10000
LockGUI
RequestFont '"Select the Font Path"'
IF RC = 0 THEN DO
PARSE VALUE RESULT WITH '"' font_path '"'
RequestPath '"Select the Image Path"'
IF RC = 0 THEN DO
PARSE VALUE RESULT WITH '"' image_path '"'
NewFont
IF RC = 0 THEN DO
ListFonts '"'font_path'"'
IF RC = 0 THEN DO
fontlist = RESULT
tmpfname = 'T:ctrx_temp.'PRAGMA('ID')
IF OPEN('listfile', tmpfname, W) THEN DO
WRITECH('listfile', fontlist)
CALL CLOSE('listfile')
IF OPEN('listfile', tmpfname, R) THEN DO
errcode = 0
DO FOREVER
curfont = READLN('listfile')
IF EOF('listfile') THEN BREAK
LoadFont FORCE '"'font_path'"' NAME curfont
IF RC = 0 THEN DO
PARSE VALUE curfont WITH '"' fontname '"' fontsize fontstyle .
imgname = image_path
IF RIGHT(image_path,1) ~= ':' THEN
imgname = imgname || '/'
imgname = imgname || fontname'_'fontsize
IF LENGTH(fontstyle) ~= 0 THEN
imgname = imgname'_'fontstyle
SaveFontImage '"'imgname'.pic"'
IF RC ~= 0 THEN DO
errcode = RC
IF RC = 5 THEN
errmess = 'User abort during save.'
ELSE
errmess = 'Error 'RC' during save.'
END
END
ELSE DO
errcode = RC
IF RC = 5 THEN
errmess = 'User abort during load.'
ELSE
errmess = 'Error 'RC' during load.'
END
END
CALL CLOSE('listfile')
IF errcode > 0 THEN DO
SAY errmess
RequestNotify 'PROMPT="'errmess'"'
END
END
ADDRESS COMMAND 'Delete >NIL: 'tmpfname
END
END
END
END
END
UnlockGUI